***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
OKI=.F.                                                                                                                                                                                                                                                   
DO WHILE .NOT. OKI                                                                                                                                                                                                                                        
   if lastkey()=27                                                                                                                                                                                                                                        
      return                                                                                                                                                                                                                                              
   endif                                                                                                                                                                                                                                                  
   KODEPAT=PAT_FILCOD                                                                                                                                                                                                                                     
   NAME=PAT_NAME                                                                                                                                                                                                                                          
   FNAME=PAT_F_NAME                                                                                                                                                                                                                                       
   MINIT=PAT_M_INIT                                                                                                                                                                                                                                       
   DOB=PAT_DOB                                                                                                                                                                                                                                            
   CODCRP=PAT_CODCRP                                                                                                                                                                                                                                      
   PATNAT=PAT_NATIO                                                                                                                                                                                                                                       
   PATN=PAT_NATIO                                                                                                                                                                                                                                         
   SEX=PAT_SEX                                                                                                                                                                                                                                            
   OSEX=PAT_SEX                                                                                                                                                                                                                                           
   BLOODGR=BLOOD_GRP                                                                                                                                                                                                                                      
   BLOODRH=BLOOD_RHE                                                                                                                                                                                                                                      
** 16/06/2000 - dickson - start - new field: Marital Status & Kids Indicator
   MARITAL=PAT_MARITA
   KIDS_IND=PAT_KIDS
** 16/06/2000

   natk=space(4)
   SET COLOR TO BG+/B                                                                                                                                                                                                                                     
   @ 10,1 CLEAR to 23,78                                                                                                                                                                                                                                  
   DO BOXT WITH 10,1,"NAME : "+NAME+" FIRST NAME : "+FNAME+" MIDDLE INITIAL : "+MINIT,'BG+','B',.F.,.F.                                                                                                                                                   
*   MINIT=SPACE(1)                                                                                                                                                                                                                                        
   NAMEI1=SUBS(NAME,1,1)                                                                                                                                                                                                                                  
   @ 12,1 CLEA TO 23,78                                                                                                                                                                                                                                   
   DO BOXT WITH 16,1,"PLEASE DO NOT CHANGE THE INITIAL NAME !!!",'GR+','R',.F.,.T.                                                                                                                                                                        
   DO BOXEN WITH 10,1,"NAME :",'NAME','BG+','B','W+','N',16,.F.,.F.                                                                                                                                                                                       
   NAMEI2=SUBS(NAME,1,1)                                                                                                                                                                                                                                  
   IF NAMEI1<>NAMEI2                                                                                                                                                                                                                                      
      DO BOXT WITH 16,1,"YOU CAN NOT CHANGE THE INITIAL NAME, TYPE ANY KEY !",'GR+*','R',.F.,.T.                                                                                                                                                          
      WAIT ''                                                                                                                                                                                                                                             
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   DO BOXEN WITH 10,25,"FIRST NAME :",'FNAME','BG+','B','W+','N',16,.F.,.F.                                                                                                                                                                               
   DO BOXEN WITH 10,55,"MIDDLE INITIAL :",'MINIT','BG+','B','W+','N',1,.F.,.F.                                                                                                                                                                            
   @ 10,1 CLEA TO 23,78                                                                                                                                                                                                                                   
   DO BOXT WITH 10,1,"NAME : "+NAME+" FIRST NAME : "+FNAME+" MIDDLE INITIAL : "+MINIT,'BG+','B',.F.,.F.                                                                                                                                                   
   DO BOXT WITH 12,1,"DATE of BIRTH : "+DTOC(DOB)+",   NATIONALITY : "+ALLTRIM(PATNAT)+",   SEX : "+SEX,'BG+','B',.F.,.F.                                                                                                                                 
   @ 14,1 CLEA TO 23,78                                                                                                                                                                                                                                   
   STORE SPACE(16) TO PATNATM,PATNATF,PATNAT                                                                                                                                                                                                              
*   DOB=CTOD("  /  /    ")                                                                                                                                                                                                                                
*   SEX=SPACE(1)                                                                                                                                                                                                                                          
   DO BOXDM WITH 12,1,"DATE of BIRTH :",'DOB','BG+','B','W+','N','DATE()','DATE()-36500',.F.,.F.                                                                                                                                                          
   DO WHILE PATNATF=SPACE(16) .AND. PATNATM=SPACE(16)                                                                                                                                                                                                     
      do boxt with 12,27,'NATIONALITY :','BG+','B',.F.,.F.                                                                                                                                                                                                
      DO NATIONAL                                                                                                                                                                                                                                         
      IF LASTKEY()=27                                                                                                                                                                                                                                     
         PATNAT=PATN                                                                                                                                                                                                                                      
         PATNATF=PATN                                                                                                                                                                                                                                     
         PATNATM=PATN                                                                                                                                                                                                                                     
      ELSE                                                                                                                                                                                                                                                
         IF LASTKEY()=13                                                                                                                                                                                                                                  
            PATNAT = PATNATF                                                                                                                                                                                                                              
         ENDIF                                                                                                                                                                                                                                            
      ENDIF                                                                                                                                                                                                                                               
*      IF LASTKEY()<>13                                                                                                                                                                                                                                   
*         SET COLOR TO BG+/B                                                                                                                                                                                                                              
*         @ 12,27 CLEA TO 23,78                                                                                                                                                                                                                           
*         PATNAT=PATNATF                                                                                                                                                                                                                                  
*      ENDif                                                                                                                                                                                                                                              
      ENDDO                                                                                                                                                                                                                                               
      SELE 1                                                                                                                                                                                                                                              
      set color to bg+/b                                                                                                                                                                                                                                  
      @ 12,1 clea to 23,78                                                                                                                                                                                                                                
      DO BOXT WITH 12,1,"DATE of BIRTH : "+DTOC(DOB)+",   NATIONALITY : "+ALLTRIM(PATNAT)+"    SEX : "+SEX,'BG+','B',.F.,.F.                                                                                                                              
      IF SEX = 'M'                                                                                                                                                                                                                                        
         PS=1                                                                                                                                                                                                                                             
      ELSE                                                                                                                                                                                                                                                
         PS=2                                                                                                                                                                                                                                             
      ENDIF                                                                                                                                                                                                                                               
      DO BOX2 WITH 12,56,"SEX :",'M','F','BG+','B','W+','N',PS,.F.,.F.                                                                                                                                                                                    
      IF PS=1                                                                                                                                                                                                                                             
         SEX='M'                                                                                                                                                                                                                                          
         PATNAT=PATNATM                                                                                                                                                                                                                                   
      ELSE                                                                                                                                                                                                                                                
         IF PS=2                                                                                                                                                                                                                                          
            SEX='F'                                                                                                                                                                                                                                       
            PATNAT=PATNATF                                                                                                                                                                                                                                
         ELSE                                                                                                                                                                                                                                             
            SEX=OSEX                                                                                                                                                                                                                                      
         ENDIF                                                                                                                                                                                                                                            
      ENDIF                                                                                                                                                                                                                                               
       @ 12,1 CLEA TO 23,78                                                                                                                                                                                                                               
       DO BOXT WITH 12,1,"DATE of BIRTH : "+DTOC(DOB)+",   NATIONALITY : "+ALLTRIM(PATNAT)+"    SEX : "+SEX,'BG+','B',.F.,.F.                                                                                                                             

** Dickson - Start (18-June-2001) - Removethe unnecessary
** Reactive by Buu (23/11/2001) - Requested by Tanya
   @ 15, 3 SAY "BLOOD GROUP : "+BLOODGR  PICT "@!"                                                                                                                                                                                                        
   @ 15,21 SAY "RHESUS : "+BLOODRH  PICT "@!"                                                                                                                                                                                                             

   @ 15,17 GET BLOODGR  PICT "@!"
   @ 15,30 GET BLOODRH  PICT "@!"                                                                                                                                                                                                                         
   READ
** Dickson - End (18-June-2001)

**
**   16/06/2000 - Dickson - Start
**       add in new fields - MARITAL & KIDS Indicator
   store .f. to DONE
   DO WHILE .NOT. DONE
         @ 17,3  say "Single/Married (S/M):"
         @ 17,30 say "With KIDs (Y/N)? :"

         @ 17,25  SAY MARITAL
         @ 17,49  say KIDS_IND

         @ 17,25  GET MARITAL PICT "@!" VALID(MARITAL $ "'S''M''s''m'")
         @ 17,49  GET KIDS_IND PICT "@!" VALID(KIDS_IND $ "'Y''y''N''n'")
         READ

         if lastkey() <> 27
            DONE = .T.
         endif
   ENDDO
** 16/06/2000 - Dickson - End



   DO BOX3 WITH 20,3,"DO YOU WANT TO :",'CONFIRM','CANCEL','ESCAPE','GR+','R','W+','N',PL7,.T.,.T.
   do case                                                                                                                                                                                                                                                
      case PL7=1                                                                                                                                                                                                                                          
         OKi=.t.                                                                                                                                                                                                                                          
      case pl7=2                                                                                                                                                                                                                                          
         OKi=.f.                                                                                                                                                                                                                                          
      case pl7=3 .or. lastkey()=27                                                                                                                                                                                                                        
         return                                                                                                                                                                                                                                           
   endcase                                                                                                                                                                                                                                                
ENDDO                                                                                                                                                                                                                                                     
IF OKI                                                                                                                                                                                                                                                    
   IF REC_LOCK(0)                                                                                                                                                                                                                                         
      REPL PAT_NAME WITH NAME,PAT_F_NAME WITH FNAME,PAT_M_INIT WITH MINIT,PAT_DOB WITH DOB                                                                                                                                                                
      REPL PAT_NATIO WITH PATNAT,PAT_SEX WITH SEX,BLOOD_GRP WITH BLOODGR,BLOOD_RHE WITH BLOODRH                                                                                                                                                           

** 16/06/2000 - Dickson - start
      REPL PAT_MARITA WITH MARITAL, PAT_KIDS WITH KIDS_IND
** 16/06/2000 - Dickson - end

   ENDIF
   UNLOCK                                                                                                                                                                                                                                                 
   SELE 6                                                                                                                                                                                                                                                 
   USE &DR&F6 INDE &DR&F6,&dr&f61,&DR&F62,&dr&f63                                                                                                                                                                                                         
   SEEK CODCRP+KODEPAT                                                                                                                                                                                                                                    
   IF .NOT. EOF()                                                                                                                                                                                                                                         
      IF REC_LOCK(0)                                                                                                                                                                                                                                      
         REPL PAT_NAME WITH NAME,PAT_F_NAME WITH FNAME,PAT_M_INIT WITH MINIT,PAT_DOB WITH DOB                                                                                                                                                             
         REPL PAT_NATIO WITH PATNAT,PAT_SEX WITH SEX,BLOOD_GRP WITH BLOODGR,BLOOD_RHE WITH BLOODRH
      ENDIF
      UNLOCK                                                                                                                                                                                                                                              
   ENDIF                                                                                                                                                                                                                                                  
   SELE 1                                                                                                                                                                                                                                                 
ENDIF                                                                                                                                                                                                                                                     
